home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / gnus / nndb.el.z / nndb.el
Encoding:
Text File  |  1998-05-21  |  10.1 KB  |  333 lines

  1. ;;; nndb.el --- nndb access for Gnus
  2. ;; Copyright (C) 1997 Free Software Foundation, Inc.
  3.  
  4. ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
  5. ;;         Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de>
  6. ;;         Joe Hildebrand <joe.hildebrand@ilg.com>
  7. ;;         David Blacka <davidb@rwhois.net>
  8. ;; Keywords: news
  9.  
  10. ;; This file is NOT part of GNU Emacs.
  11.  
  12. ;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;; it under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;; GNU General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25. ;; Boston, MA 02111-1307, USA.
  26.  
  27. ;;; Commentary:
  28.  
  29. ;;; This was based upon Kai Grossjohan's shamessly snarfed code and
  30. ;;; further modified by Joe Hildebrand.  It has been updated for Red
  31. ;;; Gnus.
  32.  
  33. ;; TODO:
  34. ;;
  35. ;; * Fix bug where server connection can be lost and impossible to regain
  36. ;;   This hasn't happened to me in a while; think it was fixed in Rgnus
  37. ;;
  38. ;; * make it handle different nndb servers seemlessly
  39. ;;
  40. ;; * Optimize expire if FORCE
  41. ;;
  42. ;; * Optimize move (only expire once)
  43. ;;
  44. ;; * Deal with add/deletion of groups
  45. ;;
  46. ;; * make the backend TOUCH an article when marked as expireable (will
  47. ;;   make article expire 'expiry' days after that moment).
  48.  
  49. ;;-
  50. ;; Register nndb with known select methods.
  51.  
  52. (gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address)
  53.  
  54. ;;; Code:
  55.  
  56. (require 'nnmail)
  57. (require 'nnheader)
  58. (require 'nntp)
  59. (eval-when-compile (require 'cl))
  60.  
  61. (eval-and-compile
  62.   (unless (fboundp 'open-network-stream)
  63.     (require 'tcp)))
  64.  
  65. (eval-when-compile (require 'cl))
  66.  
  67. (eval-and-compile
  68.   (autoload 'news-setup "rnewspost")
  69.   (autoload 'news-reply-mode "rnewspost")
  70.   (autoload 'cancel-timer "timer")
  71.   (autoload 'telnet "telnet" nil t)
  72.   (autoload 'telnet-send-input "telnet" nil t)
  73.   (autoload 'timezone-parse-date "timezone"))
  74.  
  75. ;; Declare nndb as derived from nntp
  76.  
  77. (nnoo-declare nndb nntp)
  78.  
  79. ;; Variables specific to nndb
  80.  
  81. ;;- currently not used but just in case...
  82. (defvoo nndb-deliver-program "nndel"
  83.   "*The program used to put a message in an NNDB group.")
  84.  
  85. (defvoo nndb-server-side-expiry nil
  86.   "If t, expiry calculation will occur on the server side")
  87.  
  88. (defvoo nndb-set-expire-date-on-mark nil
  89.   "If t, the expiry date for a given article will be set to the time
  90. it was marked as expireable; otherwise the date will be the time the
  91. article was posted to nndb")
  92.   
  93. ;; Variables copied from nntp
  94.  
  95. (defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file)
  96.   "Like nntp-server-opened-hook."
  97.   nntp-server-opened-hook)
  98.  
  99. (defvoo nndb-address "localhost"
  100.   "*The name of the NNDB server."
  101.   nntp-address)
  102.  
  103. (defvoo nndb-port-number 9000
  104.   "*Port number to connect to."
  105.   nntp-port-number)
  106.  
  107. ;; change to 'news if you are actually using nndb for news
  108. (defvoo nndb-article-type 'mail)
  109.  
  110. (defvoo nndb-status-string nil "" nntp-status-string)
  111.  
  112.  
  113.  
  114. (defconst nndb-version "nndb 0.7"
  115.   "Version numbers of this version of NNDB.")
  116.  
  117.  
  118. ;;; Interface functions.
  119.  
  120. (nnoo-define-basics nndb)
  121.  
  122. ;;------------------------------------------------------------------
  123.  
  124. ;; this function turns the lisp list into a string list.  There is
  125. ;; probably a more efficient way to do this.
  126. (defun nndb-build-article-string (articles)
  127.   (let (art-string art)
  128.     (while articles
  129.       (setq art (pop articles))
  130.       (setq art-string (concat art-string art " ")))
  131.     art-string))
  132.  
  133. (defun nndb-build-expire-rest-list (total expire)
  134.   (let (art rest)
  135.     (while total
  136.       (setq art (pop total))
  137.       (if (memq art expire)
  138.       ()
  139.     (push art rest)))
  140.     rest))
  141.  
  142.       
  143. ;;
  144. (deffoo nndb-request-type (group &optional article)
  145.   nndb-article-type)
  146.  
  147. ;; nndb-request-update-info does not exist and is not needed
  148.  
  149. ;; nndb-request-update-mark does not exist; it should be used to TOUCH
  150. ;; articles as they are marked exipirable
  151. (defun nndb-touch-article (group article)
  152.   (nntp-send-command nil "X-TOUCH" article))
  153.  
  154. (deffoo nndb-request-update-mark
  155.   (group article mark)
  156.   "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'"
  157.   (if (and nndb-set-expire-date-on-mark (string-equal mark "E"))
  158.       (nndb-touch-article group article))
  159.   mark)
  160.  
  161. ;; nndb-request-create-group -- currently this isn't necessary; nndb
  162. ;;   creates groups on demand.
  163.  
  164. ;; todo -- use some other time than the creation time of the article
  165. ;;         best is time since article has been marked as expirable
  166.  
  167. (defun nndb-request-expire-articles-local
  168.   (articles &optional group server force)
  169.   "Let gnus do the date check and issue the delete commands."
  170.   (let (msg art delete-list (num-delete 0) rest)
  171.     (nntp-possibly-change-group group server)
  172.     (while articles
  173.       (setq art (pop articles))
  174.       (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art)
  175.       (setq msg (nndb-status-message))
  176.       (if (string-match "^423" msg)
  177.           ()
  178.     (or (string-match "'\\(.+\\)'" msg)
  179.         (error "Not a valid response for X-DATE command: %s"
  180.            msg))
  181.     (if (nnmail-expired-article-p
  182.          group
  183.          (gnus-encode-date
  184.           (substring msg (match-beginning 1) (match-end 1)))
  185.          force)
  186.         (progn
  187.           (setq delete-list (concat delete-list " " (int-to-string art)))
  188.           (setq num-delete  (1+ num-delete)))
  189.       (push art rest))))
  190.     (if (> (length delete-list) 0)
  191.     (progn 
  192.       (nnheader-message 5 "Deleting %s article(s) from %s"
  193.                 (int-to-string num-delete) group)
  194.       (nntp-send-command "^[23].*\n" "X-DELETE" delete-list))
  195.       )
  196.     
  197.     (message "")
  198.     (nconc rest articles)))
  199.  
  200. (defun nndb-get-remote-expire-response ()
  201.   (let (list)
  202.     (set-buffer nntp-server-buffer)
  203.     (goto-char (point-min))
  204.     (if (looking-at "^[34]")
  205.     ;; x-expire returned error--presume no articles were expirable)
  206.     (setq list nil)
  207.       ;; otherwise, pull all of the following numbers into the list
  208.       (re-search-forward "follows\r?\n?" nil t)
  209.       (while (re-search-forward "^[0-9]+$" nil t)
  210.     (push (string-to-int (match-string 0)) list)))
  211.     list))
  212.  
  213. (defun nndb-request-expire-articles-remote
  214.   (articles &optional group server force)
  215.   "Let the nndb backend expire articles"
  216.   (let (days art-string delete-list (num-delete 0))
  217.     (nntp-possibly-change-group group server)
  218.     
  219.     ;; first calculate the wait period in days
  220.     (setq days (or (and nnmail-expiry-wait-function
  221.             (funcall nnmail-expiry-wait-function group))
  222.            nnmail-expiry-wait))
  223.     ;; now handle the special cases
  224.     (cond (force
  225.        (setq days 0))
  226.       ((eq days 'never)
  227.        ;; This isn't an expirable group.
  228.        (setq days -1))
  229.       ((eq days 'immediate)
  230.        (setq days 0)))
  231.     
  232.  
  233.     ;; build article string
  234.     (setq art-string (concat days " " (nndb-build-article-string articles)))
  235.     (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string)
  236.     
  237.     (setq delete-list (nndb-get-remote-expire-response))
  238.     (setq num-delete (length delete-list))
  239.     (if (> num-delete 0)
  240.     (nnheader-message 5 "Deleting %s article(s) from %s"
  241.               (int-to-string num-delete) group))
  242.  
  243.     (nndb-build-expire-rest-list articles delete-list)))
  244.  
  245. (deffoo nndb-request-expire-articles
  246.     (articles &optional group server force)
  247.   "Expires ARTICLES from GROUP on SERVER.
  248. If FORCE, delete regardless of exiration date, otherwise use normal
  249. expiry mechanism."
  250.   (if nndb-server-side-expiry
  251.       (nndb-request-expire-articles-remote articles group server force)
  252.     (nndb-request-expire-articles-local articles group server force)))
  253.  
  254. (deffoo nndb-request-move-article
  255.     (article group server accept-form &optional last)
  256.   "Move ARTICLE (a number) from GROUP on SERVER.
  257. Evals ACCEPT-FORM in current buffer, where the article is.
  258. Optional LAST is ignored."
  259.   ;; we guess that the second arg in accept-form is the new group,
  260.   ;; which it will be for nndb, which is all that matters anyway
  261.   (let ((new-group (nth 1 accept-form)) result)
  262.     (nntp-possibly-change-group group server)
  263.     
  264.     ;; use the move command for nndb-to-nndb moves
  265.     (if (string-match "^nndb" new-group)
  266.     (let ((new-group-name (gnus-group-real-name new-group)))
  267.       (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name)
  268.       (cons new-group article))
  269.       ;; else move normally
  270.       (let ((artbuf (get-buffer-create " *nndb move*")))
  271.     (and
  272.      (nndb-request-article article group server artbuf)
  273.      (save-excursion
  274.        (set-buffer artbuf)
  275.        (insert-buffer-substring nntp-server-buffer)
  276.        (setq result (eval accept-form))
  277.        (kill-buffer (current-buffer))
  278.        result)
  279.      (nndb-request-expire-articles (list article)
  280.                        group
  281.                        server
  282.                        t))
  283.     result)
  284.       )))
  285.   
  286. (deffoo nndb-request-accept-article (group server &optional last)
  287.   "The article in the current buffer is put into GROUP."
  288.   (nntp-possibly-change-group group server)
  289.   (let (art msg)
  290.     (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
  291.       (nnheader-insert "")
  292.       (nntp-send-buffer "^[23].*\n"))
  293.     
  294.     (set-buffer nntp-server-buffer)
  295.     (setq msg (buffer-string (point-min) (point-max)))
  296.     (or (string-match "^\\([0-9]+\\)" msg)
  297.     (error "nndb: %s" msg))
  298.     (setq art (substring msg (match-beginning 1) (match-end 1)))
  299.     (message "nndb: accepted %s" art)
  300.     (list art)))
  301.  
  302. (deffoo nndb-request-replace-article (article group buffer)
  303.   "ARTICLE is the number of the article in GROUP to be replaced 
  304. with the contents of the BUFFER."
  305.   (set-buffer buffer)
  306.   (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article))
  307.     (nnheader-insert "")
  308.     (nntp-send-buffer "^[23.*\n")
  309.     (list (int-to-string article))))
  310.  
  311. ; nndb-request-delete-group does not exist
  312. ; todo -- maybe later
  313.  
  314. ; nndb-request-rename-group does not exist
  315. ; todo -- maybe later
  316.  
  317. ;; -- standard compatability functions
  318.  
  319. (deffoo nndb-status-message (&optional server)
  320.   "Return server status as a string."
  321.   (set-buffer nntp-server-buffer)
  322.   (buffer-string (point-min) (point-max)))
  323.  
  324. ;; Import stuff from nntp
  325.  
  326. (nnoo-import nndb
  327.   (nntp))
  328.  
  329. (provide 'nndb)
  330.  
  331.  
  332.  
  333.